home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / morris / blowmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-11-15  |  11.8 KB  |  286 lines
  1. VERSION 2.00
  2. Begin Form frmMainForm 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "TMS 'Exploding Form' Demo"
  5.    ClientHeight    =   1572
  6.    ClientLeft      =   3264
  7.    ClientTop       =   3780
  8.    ClientWidth     =   3960
  9.    Height          =   2316
  10.    Icon            =   BLOWMAIN.FRX:0000
  11.    Left            =   3216
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   1572
  14.    ScaleWidth      =   3960
  15.    Top             =   3084
  16.    Width           =   4056
  17.    Begin MsgBlaster MsgBlaster1 
  18.       Prop8           =   "Click on ""..."" for the About Box ---->"
  19.    End
  20.    Begin Label lblDummy 
  21.       Alignment       =   2  'Center
  22.       AutoSize        =   -1  'True
  23.       BackStyle       =   0  'Transparent
  24.       BorderStyle     =   1  'Fixed Single
  25.       Caption         =   "Minimise/Resize/Maximise For Demo and 'Help', 'Contents' for Explanation."
  26.       FontBold        =   0   'False
  27.       FontItalic      =   0   'False
  28.       FontName        =   "MS Sans Serif"
  29.       FontSize        =   7.8
  30.       FontStrikethru  =   0   'False
  31.       FontUnderline   =   0   'False
  32.       Height          =   408
  33.       Left            =   120
  34.       TabIndex        =   0
  35.       Top             =   120
  36.       Width           =   3732
  37.       WordWrap        =   -1  'True
  38.    End
  39.    Begin Label labDesignNote 
  40.       Alignment       =   2  'Center
  41.       AutoSize        =   -1  'True
  42.       BackColor       =   &H00FF0000&
  43.       BorderStyle     =   1  'Fixed Single
  44.       Caption         =   "The 'dynamite' control at the top left of this form is a 'Message Blaster' control. This is not visible at runtime and is used to detect/intercept Windows' messages sent to the form at runtime."
  45.       FontBold        =   0   'False
  46.       FontItalic      =   0   'False
  47.       FontName        =   "MS Sans Serif"
  48.       FontSize        =   7.8
  49.       FontStrikethru  =   0   'False
  50.       FontUnderline   =   0   'False
  51.       ForeColor       =   &H0000FFFF&
  52.       Height          =   852
  53.       Left            =   120
  54.       TabIndex        =   1
  55.       Top             =   600
  56.       Visible         =   0   'False
  57.       Width           =   3732
  58.       WordWrap        =   -1  'True
  59.    End
  60.    Begin Menu mnuHelp 
  61.       Caption         =   "&Help"
  62.       Begin Menu mnuHelpContents 
  63.          Caption         =   "&Contents"
  64.       End
  65.       Begin Menu mnuHelpSep1 
  66.          Caption         =   "-"
  67.       End
  68.       Begin Menu mnuHelpAbout 
  69.          Caption         =   "&About TMS Exploding Form Application..."
  70.       End
  71.    End
  72. '*******************************************************************************
  73. ' The Mandelbrot Set (International) Ltd. may be reached by the following means:
  74. ' CIS: 100016,2751
  75. ' Internet 100016.2751@Compuserve.com
  76. ' FAX: (+44) 01451 860142.
  77. ' Telephone: (+44) 0941 117534.
  78. ' TMS accepts no liability whatsoever for this code or demonstration.
  79. '*******************************************************************************
  80. '==========================================================
  81. '    Module - BLOWMAIN.FRM
  82. '    Module Prefix - None
  83. '    Author - Peter J. Morris. TMS Ltd.
  84. '    Date Written : #### Date - 16/11/94    Time - 03:11
  85. '    Purpose - Example of how to use API for VBITS talk.
  86. '    Revisions
  87. '    BY            WHY            AFFECTED
  88. '    Peter J. Morris. TMS Ltd. Original code.
  89. '==========================================================
  90. Option Explicit
  91. '==========================================================
  92. '    Function - Form_Load
  93. '    Author - Peter J. Morris. TMS Ltd.
  94. '    Date Written: #### Date - 16/11/94    Time - 03:11
  95. '    Purpose - See function purpose.
  96. '    Revisions:
  97. '    BY            WHY            AFFECTED
  98. '    Peter J. Morris. TMS Ltd. Original code.
  99. '    INPUTS -  None
  100. '    OUTPUTS - None
  101. '==========================================================
  102. Private Sub Form_Load ()
  103. '==========================================================
  104. '    Form: BLOWMAIN.FRM Procedure: Form_Load
  105. '    Author - Peter J. Morris. TMS Ltd.
  106. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  107. '    Copyright and status if any: Copyright 
  108.  TMS 1994,1995
  109. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  110. '    Purpose/Description In brief:
  111. '    Simple form initialisation.
  112. '=========================================================
  113. ' Set up general error handler
  114. On Error GoTo Error_Form_Load:
  115.     ' ========== Code Starts.==========
  116.     Const sHelpFile = "HELP.HLP"
  117.     ' Center window in middle of screen.
  118.     CenterWindow Me
  119.     ' Make sure text fits in labels.
  120.     DoLabels Me
  121.     ' Sub-class  this  form  using  the  message blaster control.
  122.     ' Look for one  message  only. A WM_WINDOWPOSCHANGING message
  123.     ' is  sent to  a  window  whose size, position, or z-order is
  124.     ' about to change as a result of  a  call to  SetWindowPos or
  125.     ' another similar window management function. Note that we're
  126.     ' going to get  ahead of  the  message here.  We want to know
  127.     ' where the window is going before it gets there.
  128.     MsgBlaster1.hWndTarget = Me.hWnd
  129.     MsgBlaster1.MsgList(0) = WM_WINDOWPOSCHANGING
  130.     MsgBlaster1.MsgPassage(0) = PREPROCESS
  131.     ' No un-subclass stuff is done here - it's not necessary as the
  132.     ' control handles it.
  133.     ' Set up help file path etc.
  134.     If Right$(App.Path, 1) <> "\" Then
  135.         App.HelpFile = App.Path & "\" & sHelpFile
  136.     Else
  137.         App.HelpFile = App.Path & sHelpFile
  138.     End If
  139.     ' ========== Code Ends  .==========
  140.     Exit Sub
  141. ' Error handler
  142. Error_Form_Load:
  143.     ' Call general error handler
  144.     ErrorHandler "BLOWMAIN.FRM/Form_Load", Err, Error$
  145.     ' Default resume behaviour: exit this sub/func
  146.     Resume Exit_Form_Load:
  147. Exit_Form_Load:
  148. End Sub
  149. '==========================================================
  150. '    Function - mnuHelpAbout_Click
  151. '    Author - Peter J. Morris. TMS Ltd.
  152. '    Date Written: #### Date - 16/11/94    Time - 03:11
  153. '    Purpose - See function purpose.
  154. '    Revisions:
  155. '    BY            WHY            AFFECTED
  156. '    Peter J. Morris. TMS Ltd. Original code.
  157. '    INPUTS -  None
  158. '    OUTPUTS - None
  159. '==========================================================
  160. Private Sub mnuHelpAbout_Click ()
  161. '==========================================================
  162. '    Form: BLOWMAIN.FRM Procedure: mnuHelpAbout_Click
  163. '    Author - Peter J. Morris. TMS Ltd.
  164. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  165. '    Copyright and status if any: Copyright 
  166.  TMS 1994,1995
  167. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  168. '    Purpose/Description In brief:
  169. '    Produce simple 'About' message box.
  170. '=========================================================
  171. ' Set up general error handler
  172. On Error GoTo Error_mnuHelpAbout_Click:
  173.     ' ========== Code Starts.==========
  174.     MsgBox "'Blowup' was written by The Mandelbrot Set (Int'l) Ltd. for VBITS as a demonstration of how to access the Windows' API.", MB_OK Or MB_ICONINFORMATION, "About..."
  175.     ' ========== Code Ends  .==========
  176.     Exit Sub
  177. ' Error handler
  178. Error_mnuHelpAbout_Click:
  179.     ' Call general error handler
  180.     ErrorHandler "BLOWMAIN.FRM/mnuHelpAbout_Click", Err, Error$
  181.     ' Default resume behaviour: exit this sub/func
  182.     Resume Exit_mnuHelpAbout_Click:
  183. Exit_mnuHelpAbout_Click:
  184. End Sub
  185. '==========================================================
  186. '    Function - mnuHelpContents_Click
  187. '    Author - Peter J. Morris. TMS Ltd.
  188. '    Date Written: #### Date - 16/11/94    Time - 03:11
  189. '    Purpose - See function purpose.
  190. '    Revisions:
  191. '    BY            WHY            AFFECTED
  192. '    Peter J. Morris. TMS Ltd. Original code.
  193. '    INPUTS -  None
  194. '    OUTPUTS - None
  195. '==========================================================
  196. Private Sub mnuHelpContents_Click ()
  197. '==========================================================
  198. '    Form: BLOWMAIN.FRM Procedure: mnuHelpContents_Click
  199. '    Author - Peter J. Morris. TMS Ltd.
  200. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  201. '    Copyright and status if any: Copyright 
  202.  TMS 1994,1995
  203. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  204. '    Purpose/Description In brief:
  205. '    Fire up help file on the contents page.
  206. '=========================================================
  207. ' Set up general error handler
  208. On Error GoTo Error_mnuHelpContents_Click:
  209.     ' ========== Code Starts.==========
  210.     Const HELP_CONTENTS = &H3
  211.     ' Start help file.
  212.     If WinHelp(Me.hWnd, App.HelpFile, HELP_CONTENTS, 0) = 0 Then
  213.         MsgBox "WinHelp cannot start the help file for some reason!", MB_OK, "Error"
  214.     End If
  215.     ' ========== Code Ends  .==========
  216.     Exit Sub
  217. ' Error handler
  218. Error_mnuHelpContents_Click:
  219.     ' Call general error handler
  220.     ErrorHandler "BLOWMAIN.FRM/mnuHelpContents_Click", Err, Error$
  221.     ' Default resume behaviour: exit this sub/func
  222.     Resume Exit_mnuHelpContents_Click:
  223. Exit_mnuHelpContents_Click:
  224. End Sub
  225. '==========================================================
  226. '    Function - MsgBlaster1_Message
  227. '    Author - Peter J. Morris. TMS Ltd.
  228. '    Date Written: #### Date - 16/11/94    Time - 03:11
  229. '    Purpose - See function purpose.
  230. '    Revisions:
  231. '    BY            WHY            AFFECTED
  232. '    Peter J. Morris. TMS Ltd. Original code.
  233. '    INPUTS -  See Message Blaster documentation.
  234. '    OUTPUTS - See Message Blaster documentation.
  235. '==========================================================
  236. Private Sub MsgBlaster1_Message (MsgVal As Integer, wParam As Integer, lParam As Long, ReturnVal As Long)
  237. '==========================================================
  238. '    Form: BLOWMAIN.FRM Procedure: MsgBlaster1_Message
  239. '    Author - Peter J. Morris. TMS Ltd.
  240. '    Template fitted: #### Date - 16/11/94    Time - 03:11
  241. '    Copyright and status if any: Copyright 
  242.  TMS 1994,1995
  243. '    All rights reserved. Status @BLUE@TMS.DEMO@COLD
  244. '    Purpose/Description In brief:
  245. '    Sub-class a form window looking for a WM_WINDOWPOSCHANGING
  246. '    message to arrive.  This  message may  cause the window to
  247. '    blowup!
  248. '=========================================================
  249. ' Set up general error handler
  250. 'On Error GoTo Error_MsgBlaster1_Message:
  251.     ' ========== Code Starts.==========
  252.     ' Used to hold our window's new screen position.
  253.     Dim wp As WINDOWPOS
  254.     ' Used for call to TMSExplodeForm.
  255.     Dim rs As RECT
  256.     ' #1
  257.     ' Get our window's new position by calling our custom DLL function.
  258.     ' CopyWP1 is the function nGetWindowPos().
  259.     g_vDummy = CopyWP1(wp, lParam)
  260.     ' #2
  261.     ' This would work but for the way in which this type of function
  262.     ' typically works. CopyWP2 is the function lstrcpyn()
  263.     ' g_vDummy = CopyWP2(wp, lParam, Len(wp))
  264.     ' #3
  265.     ' This WORKS! This is an 'undeclared' function (as so far as the Visual Basic docs go)
  266.     ' and is normally used to copy a bit of memory from somewhere to somewhere else - perfect!
  267.     ' CopyWP3 is the function hmemcpy().
  268.     ' CopyWP3 wp, lParam, Len(wp)
  269.     ' Convert positional info to a rect.
  270.         rs.Left = wp.X
  271.         rs.Right = wp.CX + wp.X
  272.         rs.Top = wp.Y
  273.         rs.Bottom = wp.CY + wp.Y
  274.     ' Explode us!
  275.     TMSExplodeForm Me, rs, wp.Flags
  276.     ' ========== Code Ends  .==========
  277.     Exit Sub
  278. ' Error handler
  279. Error_MsgBlaster1_Message:
  280.     ' Call general error handler
  281.     ErrorHandler "BLOWMAIN.FRM/MsgBlaster1_Message", Err, Error$
  282.     ' Default resume behaviour: exit this sub/func
  283.     Resume Exit_MsgBlaster1_Message:
  284. Exit_MsgBlaster1_Message:
  285. End Sub
  286.